Syntax10.Scn.Fnt
StampElems
Alloc
29 Jan 96
MODULE QuickDrawPrinter; (*mf 6.7.93 / mah 
	IMPORT
		SYSTEM, Sys, Macintosh, Display, Display1, Printer, Files, Texts, Fonts, Viewers, TextFrames, Oberon, Directories;
	CONST
		white=FALSE;
		maxfonts=64;
		fntScale=72;
	TYPE
		Poly=RECORD a, b, c, d, t: REAL END;
		PolyVector=ARRAY 20 OF Poly;
		FontDescr=RECORD
			num, size, face: INTEGER;
			map: Macintosh.FontMapPtr
		END;
		dpi: LONGINT; pageOpen: BOOLEAN;
		printPort: Sys.GrafPtr; printHnd: Sys.TPrHnd; prStatus: Sys.TPrStatus;
		nofonts: INTEGER; fontname: ARRAY maxfonts, 32 OF CHAR; font: ARRAY maxfonts OF Macintosh.FontMapPtr;
		d: Directories.Directory;
	PROCEDURE ^Open(VAR name, user: ARRAY OF CHAR; password: LONGINT);
	PROCEDURE MapString(VAR fname: ARRAY OF CHAR; VAR s, ms: ARRAY OF CHAR);
		VAR i, j: INTEGER; back: CHAR;
	BEGIN i:=0; j:=0;
		LOOP
			CASE s[i] OF
			| 0X: ms[j]:=0X; RETURN
			| 9X: ms[j]:=" "; INC(j); ms[j]:=" "; INC(j); ms[j]:=" "; INC(j); ms[j]:=" "
			| "_":
				back := fname[6]; fname[6] := 0X;
				IF (Macintosh.syntaxFnt # Macintosh.helveticFnt) & (fname = "Syntax") THEN ms[j]:="-" ELSE ms[j] := '_' END;
				fname[6] := back
			| 80X: ms[j]:=80X (*Ae*)
			| 81X: ms[j]:=85X (*Oe*)
			| 82X: ms[j]:=86X (*Ue*)
			| 83X: ms[j]:=8AX (*ae*)
			| 84X: ms[j]:=9AX (*oe*)
			| 85X: ms[j]:=9FX (*ue*)
			ELSE ms[j]:=s[i]
			END;
			INC(i); INC(j)
		END
	END MapString;
	PROCEDURE EnterFont(fontno: INTEGER; VAR fname: ARRAY OF CHAR);
		VAR fntNum, fntSize, fntFace, i: INTEGER;
	BEGIN Macintosh.GetFontInfo(fname, fntNum, fntSize, fntFace); fntSize:=SHORT(fntSize*dpi DIV fntScale);
		IF fntNum=Macintosh.syntaxFnt THEN fntNum:=Macintosh.helveticFnt END;
		font[fontno]:=Macintosh.NewFontMap(fntNum, fntSize, fntFace); 
(*		IF printPort = 0 THEN printPort:=Sys.PrOpenDoc(printHnd, 0, 0) END; *)
		IF printPort # 0 THEN Macintosh.SetPenPort(SYSTEM.VAL (Sys.GrafPtr, printPort))  END;
	END EnterFont;
	PROCEDURE SetDocTitle;
		VAR str: Sys.Str255;
	BEGIN Macintosh.SetStr255(str, "Oberon document");
		Sys.SetWTitle(SYSTEM.VAL (Sys.GrafPtr, Macintosh.thePortPtr), str)
	END SetDocTitle;
	PROCEDURE GetDPI;
		TYPE
			XY=RECORD x, y: INTEGER END;
			GetRsl=RECORD op, err: INTEGER; misc: ARRAY 7 OF INTEGER; cnt: INTEGER; res: ARRAY 27 OF XY END;
			SetRsl=RECORD op, err: INTEGER; dum: LONGINT; hPrint: Sys.TPrHnd; x, y: INTEGER END;
		VAR
			res: XY; getRsl: GetRsl; setRsl: SetRsl; i: INTEGER;
	BEGIN dpi:=0; getRsl.op:=4; Sys.PrGeneral(SYSTEM.ADR(getRsl));
		IF (getRsl.err=0)&(Sys.PrError()=0) THEN i:=0;
			WHILE i < getRsl.cnt DO res:=getRsl.res[i];
				IF (res.x=res.y)&(res.x > dpi) THEN dpi:=res.y END;
				INC(i)
			END;
			setRsl.hPrint:=printHnd; setRsl.x:=SHORT(dpi); setRsl.y:=SHORT(dpi); setRsl.op:=5; Sys.PrGeneral(SYSTEM.ADR(setRsl));
			IF (setRsl.err#0)OR(Sys.PrError()#0) THEN dpi:=0 END
		END
	END GetDPI;
	PROCEDURE * Open(VAR name, user: ARRAY OF CHAR; password: LONGINT);
		VAR ph: Sys.TPrRealHnd; pp: Sys.TPrRealPtr;
	BEGIN nofonts:=0; Printer.res:=1;
		d := Directories.Current(); 
		Sys.PrOpen;
		IF Sys.PrError()=0 THEN SetDocTitle; Sys.PrintDefault(printHnd); GetDPI;
			IF (dpi#0) & Sys.PrStlDialog(printHnd) & Sys.PrJobDialog(printHnd) THEN printPort:=Sys.PrOpenDoc(printHnd, 0, 0);
				IF Sys.PrError()=0 THEN pageOpen:=FALSE; Printer.res:=0;
					ph:=SYSTEM.VAL (Sys.TPrRealHnd, printHnd);
					pp:=SYSTEM.VAL (Sys.TPrRealPtr, ph.p);
					Printer.PageWidth:=SHORT(LONG(pp.right)*300 DIV dpi);
					Printer.PageHeight:=SHORT(LONG(pp.bottom)*300 DIV dpi)
				ELSE Sys.PrCloseDoc(printPort); Sys.PrClose END
			ELSE Sys.PrClose END
		ELSE Sys.PrClose END;
		Directories.Change (d.path)
	END Open;
	PROCEDURE OpenPage;
	BEGIN
		IF printPort = 0 THEN printPort:=Sys.PrOpenDoc(printHnd, 0, 0) END; 
		IF ~pageOpen THEN Sys.PrOpenPage(printPort, 0);
			IF Sys.PrError()#0 THEN HALT(99) END;
			Macintosh.SetPenPort(printPort); Sys.TextMode(1); Sys.PenMode(0); pageOpen:=TRUE
(*			Macintosh.SetPenPort(printPort); Sys.TextMode(1); Sys.PenMode(9); pageOpen:=TRUE *)
		END
	END OpenPage;
	PROCEDURE * Page(nofcopies: INTEGER);
	BEGIN Sys.PrClosePage(printPort);
		IF Sys.PrError()#0 THEN HALT(99) END;
		pageOpen:=FALSE
	END Page;
	PROCEDURE * Close;
		VAR ph: Sys.TPrRealHnd; pp: Sys.TPrRealPtr;
	BEGIN
		IF pageOpen THEN Page(0) END;
		Sys.PrCloseDoc(printPort);
		IF Sys.PrError()#0 THEN HALT(99) END;
		ph:=SYSTEM.VAL (Sys.TPrRealHnd, printHnd);
		pp:=SYSTEM.VAL (Sys.TPrRealPtr, ph.p);
		IF pp.bjdl=1 THEN Sys.PrPicFile(printHnd, 0, 0, 0, prStatus) END;
		Sys.PrClose; printPort := 0;
		WHILE nofonts > 0 DO DEC(nofonts); fontname[nofonts, 0]:=" " END;
		Directories.Change (d.path)
	END Close;
	PROCEDURE fontno(VAR name: ARRAY OF CHAR): INTEGER;
		VAR i, j: INTEGER;
	BEGIN i:=0;
		WHILE (i < nofonts) & (fontname[i]#name) DO INC(i) END;
		IF i=nofonts THEN
			IF nofonts < maxfonts THEN COPY(name, fontname[i]); INC(nofonts); EnterFont(i, name) ELSE i:=0 END
		END;
		RETURN i
	END fontno;
	PROCEDURE * UseListFont(VAR name: ARRAY OF CHAR);
		VAR i: INTEGER; listfont: ARRAY 32 OF CHAR;
	BEGIN listfont:="Times9.Scn.Fnt"; i:=0;
		WHILE (i < nofonts) & (fontname[i]#name) DO INC(i) END;
		IF i=nofonts THEN COPY(name, fontname[i]); INC(nofonts); EnterFont(i, listfont) END;
	END UseListFont;
	PROCEDURE * ReplConst(x, y, w, h: INTEGER);
	BEGIN OpenPage; Macintosh.ReplConst(
		SHORT((x*dpi+150) DIV 300), SHORT(((Printer.PageHeight-y)*dpi+150) DIV 300),
		SHORT((w*dpi+150) DIV 300), SHORT((h*dpi+150) DIV 300))
	END ReplConst;
	PROCEDURE * ContString(VAR s, fname: ARRAY OF CHAR);
		VAR ms: ARRAY 4096 OF CHAR;
	BEGIN OpenPage; MapString(fname, s, ms); Macintosh.ContString(font[fontno(fname)], ms)
	END ContString;
	PROCEDURE * String(x, y: INTEGER; VAR s, fname: ARRAY OF CHAR);
		VAR ms: ARRAY 4096 OF CHAR; fnt: Macintosh.FontMapRealPtr;
	BEGIN OpenPage; fnt:=SYSTEM.VAL (Macintosh.FontMapRealPtr, font[fontno(fname)]); MapString(fname, s, ms);
		Macintosh.String(font[fontno(fname)],
		SHORT((x*dpi+150) DIV 300), SHORT(((Printer.PageHeight-y-fnt.ndescent)*dpi+150) DIV 300), ms)
	END String;
	PROCEDURE * ReplPattern(x, y, w, h, col: INTEGER);
	BEGIN OpenPage; Macintosh.ReplPattern(Display1.ThisPattern(col),
		SHORT((x*dpi+150) DIV 300), SHORT(((Printer.PageHeight-y)*dpi+150) DIV 300),
		SHORT((w*dpi+150) DIV 300), SHORT((h*dpi+150) DIV 300))
	END ReplPattern;
	PROCEDURE * Picture(x, y, w, h, mode: INTEGER; adr: LONGINT);
		VAR p: Sys.GrafPtr;
	BEGIN p:=SYSTEM.VAL(Sys.GrafPtr, adr); OpenPage; Macintosh.CopyBlock(p, printPort, 0, h, w, h,
		SHORT((x*dpi+150) DIV 300), SHORT(((Printer.PageHeight-y)*dpi+150) DIV 300),
		SHORT((w*dpi*2+75) DIV 150), SHORT((h*dpi*2+75) DIV 150));
	END Picture;
	PROCEDURE * Circle(x0, y0, r: INTEGER);
	BEGIN OpenPage; Macintosh.Circle(
		SHORT((x0*dpi+150) DIV 300), SHORT(((Printer.PageHeight-y0)*dpi+150) DIV 300), SHORT((r*dpi+150) DIV 300))
	END Circle;
	PROCEDURE * Ellipse(x0, y0, a, b: INTEGER);
	BEGIN OpenPage; Macintosh.Ellipse(
		SHORT((x0*dpi+150) DIV 300), SHORT(((Printer.PageHeight-y0)*dpi+150) DIV 300),
		SHORT((a*dpi+150) DIV 300), SHORT((b*dpi+150) DIV 300))
	END Ellipse;
	PROCEDURE * Line(x0, y0, x1, y1: INTEGER);
	BEGIN OpenPage; Macintosh.Line(
		SHORT((x0*dpi+150) DIV 300), SHORT(((Printer.PageHeight-y0)*dpi+150) DIV 300),
		SHORT((x1*dpi+150) DIV 300), SHORT(((Printer.PageHeight-y1)*dpi+150) DIV 300))
	END Line;
	PROCEDURE PrintPoly(VAR p, q: Poly; lim: REAL);
		VAR t: REAL;
	BEGIN t:=0;
		REPEAT Macintosh.Dot(
			SHORT(ENTIER(((((p.a*t+p.b)*t+p.c)*t+p.d)*dpi/300)+0.5)),
			SHORT(ENTIER((((Printer.PageHeight-1)-(((q.a*t+q.b)*t+q.c)*t+q.d))*dpi/300)+0.5)));
			t:=t+1.0
		UNTIL t >=lim
	END PrintPoly;
	PROCEDURE * Spline(x0, y0, n, open: INTEGER; VAR X, Y: ARRAY OF INTEGER);
		VAR i: INTEGER; dx, dy, ds: REAL; x, xd, y, yd, s: Macintosh.RealVector; p, q: PolyVector;
	BEGIN x[0]:=X[0]+x0; y[0]:=Y[0]+y0; s[0]:=0; i:=1;
		WHILE i < n DO x[i]:=X[i]+x0; dx:=x[i]-x[i-1]; y[i]:=Y[i]+y0; dy:=y[i]-y[i-1]; s[i]:=ABS(dx)+ABS(dy)+s[i-1]; INC(i) END;
		IF open=1 THEN Macintosh.OpenSpline(s, x, xd, n); Macintosh.OpenSpline(s, y, yd, n)
		ELSE Macintosh.ClosedSpline(s, x, xd, n); Macintosh.ClosedSpline(s, y, yd, n) END;
		i:=0;
		WHILE i < n-1 DO ds:=1.0/(s[i+1]-s[i]); dx:=(x[i+1]-x[i])*ds; dy:=ds*(y[i+1]-y[i]);
			p[i].a:=ds*ds*(xd[i]+xd[i+1]-2.0*dx); p[i].b:=ds*(3.0*dx-2.0*xd[i]-xd[i+1]); p[i].c:=xd[i]; p[i].d:=x[i]; p[i].t:=s[i];
			q[i].a:=ds*ds*(yd[i]+yd[i+1]-2.0*dy); q[i].b:=ds*(3.0*dy-2.0*yd[i]-yd[i+1]); q[i].c:=yd[i]; q[i].d:=y[i]; q[i].t:=s[i]; INC(i)
		END;
		p[i].t:=s[i]; q[i].t:=s[i];
		OpenPage; i:=0;
		WHILE i < n-1 DO PrintPoly(p[i], q[i], p[i+1].t-p[i].t); INC(i) END
	END Spline;
	PROCEDURE * GetMetrics (VAR fname: ARRAY OF CHAR; VAR fdx: ARRAY OF SHORTINT; VAR found: BOOLEAN);
		VAR fnt: Macintosh.FontMapRealPtr; i: INTEGER; back: CHAR;
	BEGIN fnt:=SYSTEM.VAL (Macintosh.FontMapRealPtr, font[fontno(fname)]); found:=TRUE; i:=0;
		WHILE i < 0FFH DO fdx[i]:=SHORT(SHORT((LONG(fnt.width[i])*600+dpi) DIV (2*dpi))); INC(i) END;
		back := fname[6]; fname[6] := 0X;
		IF (Macintosh.syntaxFnt # Macintosh.helveticFnt) & (fname = "Syntax") THEN fdx[ORD("_")]:=fdx[ORD("-")] END;
		fname[6] := back;
		fdx[81H]:=fdx[85H]; fdx[82H]:=fdx[86H]; fdx[83H]:=fdx[8AH]; fdx[84H]:=fdx[9AH]; fdx[85H]:=fdx[9FH]
	END GetMetrics;
	PROCEDURE Install*;
	BEGIN Macintosh.prQD:=TRUE;
		Macintosh.prOpen:=Open; Macintosh.prClose:=Close; Macintosh.prPage:=Page;
		Macintosh.prCircle:=Circle; Macintosh.prEllipse:=Ellipse; Macintosh.prLine:=Line; Macintosh.prSpline:=Spline;
		Macintosh.prPicture:=Picture; Macintosh.prReplConst:=ReplConst; Macintosh.prReplPattern:=ReplPattern;
		Macintosh.prString:=String; Macintosh.prContString:=ContString; Macintosh.prUseListFont:=UseListFont;
		Macintosh.prGetMetrics:=GetMetrics
	END Install;
BEGIN  printHnd:=Sys.NewHandle (120); Sys.PrOpen; Sys.PrintDefault(printHnd); GetDPI; Sys.PrClose
END QuickDrawPrinter.